Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/commontp.zip/IBMCOM.ZIP/IBMCOM.PAS

Pascal/Delphi Source File | 1990-06-21 | 13KB | 539 lines

CONST
  max_port = 4;


{Base i/o address for each COM port}

CONST
  uart_base: ARRAY [1..max_port] OF Integer = ($3F8, $2F8, $3E8, $2E8);


{Interrupt numbers for each COM port}

CONST
  intnums: ARRAY [1..max_port] OF Byte = ($0C, $0B, $0C, $0B);


{i8259 interrupt levels for each port}

CONST
  i8259levels: ARRAY [1..max_port] OF Byte = (4, 3, 4, 3);


{This variable is TRUE if the interrupt driver has been installed, or FALSE
if it hasn't.  It's used to prevent installing twice or deinstalling when not
installed.}

CONST
  com_installed: Boolean = False;


{UART i/o addresses.  Values depend upon which COMM port is selected.}

VAR
  uart_data: Word;             {Data register}
  uart_ier : Word;             {Interrupt enable register}
  uart_iir : Word;             {Interrupt identification register}
  uart_lcr : Word;             {Line control register}
  uart_mcr : Word;             {Modem control register}
  uart_lsr : Word;             {Line status register}
  uart_msr : Word;             {Modem status register}
  uart_spr : Word;             {Scratch pad register}


{Original contents of IER and MCR registers.  Used to restore UART
to whatever state it was in before this driver was loaded.}

VAR
  old_ier: Byte;
  old_mcr: Byte;


{Original contents of interrupt vector.  Used to restore the vector when
the interrupt driver is deinstalled.}

VAR
  old_vector: Pointer;


{Original contents of interrupt controller mask.  Used to restore the
bit pertaining to the comm controller we're using.}

VAR
  old_i8259_mask: Byte;


{Bit mask for i8259 interrupt controller}

VAR
  i8259bit: Byte;


{Interrupt vector number}

VAR
  intnum: Byte;


{Receive queue.  Received characters are held here until retrieved by
com_rx.}

CONST
  rx_queue_size = 128;   {Change to suit}
VAR
  rx_queue: ARRAY [1..rx_queue_size] OF Byte;
  rx_in   : Word;        {Index of where to store next character}
  rx_out  : Word;        {Index of where to retrieve next character}
  rx_chars: Word;        {Number of chars in queue}


{Transmit queue.  Characters to be transmitted are held here until the
UART is ready to transmit them.}

CONST
  tx_queue_size = 16;    {Change to suit}
VAR
  tx_queue: ARRAY [1..tx_queue_size] OF Byte;
  tx_in   : Integer;     {Index of where to store next character}
  tx_out  : Integer;     {Index of where to retrieve next character}
  tx_chars: integer;     {Number of chars in queue}


{This variable is used to save the next link in the "exit procedure" chain.}

VAR
  exit_save: Pointer;


{$I ints.inc}   {Macros for enabling and disabling interrupts}


{Interrupt driver.  The UART is programmed to cause an interrupt whenever
a character has been received or when the UART is ready to transmit another
character.}

{$R-,S-}
PROCEDURE com_interrupt_driver; INTERRUPT;

VAR
  ch   : Char;
  iir  : Byte;
  dummy: Byte;

BEGIN

  {While bit 0 of the interrupt identification register is 0, there is an
  interrupt to process}

  iir := Port [uart_iir];

  WHILE NOT Odd (iir) DO
    BEGIN

    CASE iir SHR 1 OF

      {iir = 100b: Received data available.  Get the character, and if
      the buffer isn't full, then save it.  If the buffer is full,
      then ignore it.}

      2:
        BEGIN
        ch := Char (Port [uart_data] );
        IF (rx_chars <= rx_queue_size) THEN
          BEGIN
          rx_queue [rx_in] := Ord (ch);
          Inc (rx_in);
          IF rx_in > rx_queue_size THEN
            rx_in := 1;
          rx_chars := Succ (rx_chars);
          END;
        END;

      {iir = 010b: Transmit register empty.  If the transmit buffer
      is empty, then disable the transmitter to prevent any more
      transmit interrupts.  Otherwise, send the character.

      The test of the line-status-register is to see if the transmit
      holding register is truly empty.  Some UARTS seem to cause transmit
      interrupts when the holding register isn't empty, causing transmitted
      characters to be lost.}

      1:
        IF (tx_chars <= 0) THEN
          Port [uart_ier] := Port [uart_ier] AND NOT 2
        ELSE
          IF Odd (Port [uart_lsr] SHR 5) THEN
            BEGIN
            Port [uart_data] := tx_queue [tx_out];
            Inc (tx_out);
            IF tx_out > tx_queue_size THEN
              tx_out := 1;
            Dec (tx_chars);
            END;

      {iir = 001b: Change in modem status.  We don't expect this interrupt,
      but if one ever occurs we need to read the line status to reset it
      and prevent an endless loop.}

      0:
        dummy := Port [uart_msr];

      {iir = 111b: Change in line status.  We don't expect this interrupt,
      but if one ever occurs we need to read the line status to reset it
      and prevent an endless loop.}

      3:
        dummy := Port [uart_lsr];

      END;

    iir := Port [uart_iir];
    END;

  {Tell the interrupt controller that we're done with this interrupt}

  Port [$20] := $20;

END;
{$R+,S+}


{Flush (empty) the receive buffer.}

PROCEDURE com_flush_rx;
BEGIN
  disable_interrupts;
  rx_chars := 0;
  rx_in    := 1;
  rx_out   := 1;
  enable_interrupts;
END;


{Flush (empty) transmit buffer.}

PROCEDURE com_flush_tx;
BEGIN
  disable_interrupts;
  tx_chars := 0;
  tx_in    := 1;
  tx_out   := 1;
  enable_interrupts;
END;


{This function returns TRUE if a carrier is present.}

FUNCTION com_carrier: Boolean;
BEGIN
  com_carrier := com_installed AND Odd (Port [uart_msr] SHR 7);
END;


{Get a character from the receive buffer.  If the buffer is empty, return
a NULL (#0).}

FUNCTION com_rx: Char;
BEGIN
  IF NOT com_installed OR (rx_chars = 0) THEN
    com_rx := #0
  ELSE
    BEGIN
    disable_interrupts;
    com_rx := Chr (rx_queue [rx_out] );
    Inc (rx_out);
    IF rx_out > rx_queue_size THEN
      rx_out := 1;
    Dec (rx_chars);
    enable_interrupts;
    END;
END;


{This function returns True if com_tx can accept a character.}

FUNCTION com_tx_ready: Boolean;
BEGIN
  com_tx_ready := (tx_chars < tx_queue_size) OR NOT com_installed;
END;


{This function returns True if the transmit buffer is empty.}

FUNCTION com_tx_empty: Boolean;
BEGIN
  com_tx_empty := (tx_chars = 0) OR NOT com_installed;
END;


{This function returns True if the receive buffer is empty.}

FUNCTION com_rx_empty: Boolean;
BEGIN
  com_rx_empty := (rx_chars = 0) OR NOT com_installed;
END;


{Send a character.  Waits until the transmit buffer isn't full, then puts
the character into it.  The interrupt driver will send the character
once the character is at the head of the transmit queue and a transmit
interrupt occurs.}

PROCEDURE com_tx (ch: Char);
BEGIN
  IF com_installed THEN
    BEGIN
    REPEAT UNTIL com_tx_ready;
    disable_interrupts;
    tx_queue [tx_in] := Ord (ch);
    IF tx_in < tx_queue_size THEN
      Inc (tx_in)
    ELSE
      tx_in := 1;
    Inc (tx_chars);
    Port [uart_ier] := Port [uart_ier] OR 2;
    enable_interrupts;
    END;
END;


{Send a whole string}

PROCEDURE com_tx_string (st: String);
VAR
  i: Byte;
BEGIN
  FOR i := 1 TO Length (st) DO
    com_tx (st [i] );
END;


{Lower (deactivate) the DTR line.  Causes most modems to hang up.}

PROCEDURE com_lower_dtr;
BEGIN
  IF com_installed THEN
    BEGIN
    disable_interrupts;
    Port [uart_mcr] := Port [uart_mcr] AND NOT 1;
    enable_interrupts;
    END;
END;


{Raise (activate) the DTR line.}

PROCEDURE com_raise_dtr;
BEGIN
  IF com_installed THEN
    BEGIN
    disable_interrupts;
    Port [uart_mcr] := Port [uart_mcr] OR 1;
    enable_interrupts;
    END;
END;


{Set the baud rate.  Accepts any speed between 2 and 65535.  However,
I am not sure that extremely high speeds (those above 19200) will
always work, since the baud rate divisor will be six or less, where a
difference of one can represent a difference in baud rate of
3840 bits per second or more.}

PROCEDURE com_set_speed (speed: Word);
VAR
  divisor: Word;
BEGIN
  IF com_installed THEN
    BEGIN
    IF speed < 2 THEN speed := 2;
    divisor := 115200 DIV speed;
    disable_interrupts;
    Port  [uart_lcr]  := Port [uart_lcr] OR $80;
    Portw [uart_data] := divisor;
    Port  [uart_lcr]  := Port [uart_lcr] AND NOT $80;
    enable_interrupts;
    END;
END;


{Set the parity and stop bits as follows:

  com_none    8 data bits, no parity
  com_even    7 data bits, even parity
  com_odd     7 data bits, odd parity
  com_zero    7 data bits, parity always zero
  com_one     7 data bits, parity always one}

PROCEDURE com_set_parity (parity: com_parity; stop_bits: Byte);
VAR
  lcr: Byte;
BEGIN
  CASE parity OF
    com_none: lcr := $00 OR $03;
    com_even: lcr := $18 OR $02;
    com_odd : lcr := $08 OR $02;
    com_zero: lcr := $38 OR $02;
    com_one : lcr := $28 OR $02;
    END;
  IF stop_bits = 2 THEN
    lcr := lcr OR $04;
  disable_interrupts;
  Port [uart_lcr] := Port [uart_lcr] AND $40 OR lcr;
  enable_interrupts;
END;

{Install the communications driver.  Portnum should be 1..max_port.
Error codes returned are:

  0 - No error
  1 - Invalid port number
  2 - UART for that port is not present
  3 - Already installed, new installation ignored}

PROCEDURE com_install
  (
  portnum  : Word;
  VAR error: Word
  );
VAR
  ier: Byte;
BEGIN
  IF com_installed THEN
    error := 3
  ELSE
    IF (portnum < 1) OR (portnum > max_port) THEN
      error := 1
    ELSE
      BEGIN

      {Set i/o addresses and other hardware specifics for selected port}

      uart_data := uart_base [portnum];
      uart_ier  := uart_data + 1;
      uart_iir  := uart_data + 2;
      uart_lcr  := uart_data + 3;
      uart_mcr  := uart_data + 4;
      uart_lsr  := uart_data + 5;
      uart_msr  := uart_data + 6;
      uart_spr  := uart_data + 7;
      intnum    := intnums [portnum];
      i8259bit  := 1 SHL i8259levels [portnum];

      {Return error if hardware not installed}

      old_ier := Port [uart_ier];
      Port [uart_ier] := 0;
      IF Port [uart_ier] <> 0 THEN
        error := 2
      ELSE
        BEGIN
        error := 0;

        {Save original interrupt controller mask, then disable the
        interrupt controller for this interrupt.}

        disable_interrupts;
        old_i8259_mask := Port [$21];
        Port [$21] := old_i8259_mask OR i8259bit;
        enable_interrupts;

        {Clear the transmit and receive queues}

        com_flush_tx;
        com_flush_rx;

        {Save current interrupt vector, then set the interrupt vector to
        the address of our interrupt driver.}

        GetIntVec (intnum, old_vector);
        SetIntVec (intnum, @com_interrupt_driver);
        com_installed := True;

        {Set parity to none, turn off BREAK signal, and make sure
        we're not addressing the baud rate registers.}

        Port [uart_lcr] := 3;

        {Save original contents of modem control register, then enable
        interrupts to system bus and activate RTS.  Leave DTR the way
        it was.}

        disable_interrupts;
        old_mcr := Port [uart_mcr];
        Port [uart_mcr] := $A OR (old_mcr AND 1);
        enable_interrupts;

        {Enable interrupt on data-available.  The interrupt for
        transmit-ready is enabled when a character is put into the
        transmit queue, and disabled when the transmit queue is empty.}

        Port [uart_ier] := 1;

        {Enable the interrupt controller for this interrupt.}

        disable_interrupts;
        Port [$21] := Port [$21] AND NOT i8259bit;
        enable_interrupts;

        END;
      END;
END;


{Deinstall the interrupt driver completely.  It doesn't change the baud rate
or mess with DTR; it tries to leave the interrupt vectors and enables and
everything else as it was when the driver was installed.

This procedure MUST be called by the exit procedure of this module before
the program exits to DOS, or the interrupt driver will still
be attached to its vector -- the next communications interrupt that came
along would jump to the interrupt driver which is no longer protected and
may have been written over.}


PROCEDURE com_deinstall;
BEGIN
  IF com_installed THEN
    BEGIN

    com_installed := False;

    {Restore Modem-Control-Register and Interrupt-Enable-Register.}

    Port [uart_mcr] := old_mcr;
    Port [uart_ier] := old_ier;

    {Restore appropriate bit of interrupt controller's mask}

    disable_interrupts;
    Port [$21] := Port [$21] AND NOT i8259bit OR
     old_i8259_mask AND i8259bit;
    enable_interrupts;

    {Reset the interrupt vector}

    SetIntVec (intnum, old_vector);

    END;
END;


{This procedure is called when the program exits for any reason.  It
deinstalls the interrupt driver.}

{$F+} PROCEDURE exit_procedure; {$F-}
BEGIN
  com_deinstall;
  ExitProc := exit_save;
END;


{This installs the exit procedure.}

BEGIN
  exit_save := ExitProc;
  ExitProc := @exit_procedure;
END.